home *** CD-ROM | disk | FTP | other *** search
/ Video Toaster 4.3 / Video Toaster v4.3.iso / 3.1 / toasterall / arexx_examples / lwm / curvetext.lwm < prev    next >
Text File  |  1993-06-08  |  4KB  |  183 lines
  1. /* CMD: Curve Text
  2.  * By Arnie Cachelin © 1992, 1993 NewTek Inc. */
  3.  
  4.  
  5. libadd = addlib("LWModelerARexx.port",0)
  6. signal on error
  7. signal on syntax
  8.  
  9. call addlib "rexxsupport.library", 0, -30, 0
  10. MATHLIB="rexxmathlib.library"
  11. IF POS(MATHLIB , SHOW('L')) = 0 THEN
  12.   IF ~ADDLIB(MATHLIB , 0 , -30 , 0) THEN DO
  13.     call notify(1,"!Can't find "MATHLIB)
  14.     exit
  15.     END
  16. sysnam = 'Build Curved Text'
  17. filnam = 'ENV:CurveText.state'
  18. version = 'Curved Text v1.0'
  19.  
  20. lines=2
  21. rad=3
  22. arng=.6
  23. styles = 'Flat Block Chisel Round'
  24. typ=1
  25. deep = 0.1
  26. wide = 0.02
  27. call req_begin sysnam
  28. id_font = req_addcontrol("Use Font",'F')
  29. id_typ = req_addcontrol("Text Type", "CH",Styles)
  30. id_deep = req_addcontrol("Depth", 'n', 1)
  31. id_wide = req_addcontrol("Edge Width", 'n', 1)
  32. RadId = req_addcontrol("Radius",'N',0)
  33. TxtId = req_addcontrol("Text",'S',35)
  34. angId = req_addcontrol("Spacing",'N',0)
  35. axid = req_addcontrol("Axis", "CH",'X Y Z')
  36. surfid = req_addcontrol("Surface",'R')
  37.  
  38. call req_setval RadId, rad
  39. call req_setval TxtId, ""
  40. call req_setval id_typ, typ,1
  41. call req_setval id_deep, deep,0.1
  42. call req_setval id_wide, wide,0.02
  43. call req_setval angId, arng,0
  44. call req_setval axId, 3
  45.  
  46. if (~req_post()) then do
  47.     call req_end
  48.     exit
  49. end
  50. font = req_getval(id_font)
  51. rad = req_getval(RadId)
  52. txt = req_getval(TxtId)
  53. arng = req_getval(angId)
  54. ax = req_getval(axId)
  55. name = req_getval(surfId)
  56. typ = req_getval(id_typ)
  57. wide = req_getval(id_wide)
  58. deep = req_getval(id_deep)
  59. call req_end
  60.  
  61. call CUT()
  62. /*font=fontload(fntname)*/
  63. if font=0 then do
  64.   if(notify(2,"!Please Load A Font!","I just can't go on without one")) then do
  65.     fname=GetFileName("Load Font","/ToasterFonts")
  66.     if fname~="(none)" then do
  67.       font=fontload(fname)
  68.       if font=0 then do
  69.         call notify(1,"!Can't load font "fname)
  70.         exit
  71.         end
  72.       end
  73.     end
  74.   end
  75.  
  76. LetSiz=MAKETEXT('M', font)  /* One emm space (M width)  */
  77. box=boundingbox()  /* Should check out empty list ...  */
  78. if LetSiz~=0 then call UNDO() /* Get rid of M  */
  79. parse var box n x1 x2 y1 y2 z1 z2
  80. if ax=1 then LetSiz=1.5*abs(y2-y1)
  81. call 'PASTE'
  82. L= length(txt)
  83. W=LetSiz*L
  84. astep=(1+4*arng)*36*LetSiz/(-3.141592*rad)    /* Do this in loop to use PS kerning!! */
  85. angle=-astep
  86. call SURFACE(name)
  87. do i=1 to L
  88.   if ax=1 then call ROTATE(astep,'X',0)
  89.   else if ax=2 then call ROTATE(astep,'Y',0)
  90.   else call ROTATE(astep,'Z',0)
  91.   angle=angle+astep
  92.   call CUT()
  93.   c=substr(txt,i,1)
  94.   cw=maketext(c,font)
  95.   h=centerx()
  96.   if ax=1 then call MOVE(0 0 -1*rad)
  97.   else if ax=2 then call MOVE(0 0 -1*rad)
  98.   else  call MOVE(0 rad 0)
  99.   call PASTE()
  100.   end
  101. if ax=1 then call ROTATE(Angle/(-2),'X',0)
  102. else if ax=2 then call ROTATE(Angle/(-2),'Y',0)
  103. else call ROTATE(Angle/(-2),'Z',0)
  104. call ShapeText(typ)
  105. if (libadd) then call remlib("LWModelerARexx.port")
  106. exit
  107.  
  108. syntax:
  109. error:
  110.   call end_all
  111.     t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
  112.   if (libadd) then call remlib("LWModelerARexx.port")
  113.     exit
  114.  
  115.  
  116. Center: Procedure
  117.   box=boundingbox()  /* Should check out empty list ...  */
  118.   parse var box n x1 x2 y1 y2 z1 z2
  119.   cx=-(x2+x1)/2
  120.   cy=-(y2+y1)/2
  121.   cz=-(z2+z1)/2
  122.   call MOVE(cx cy cz)
  123.   return box
  124.  
  125. CenterX: Procedure
  126.   box=boundingbox()  /* Should check out empty list ...  */
  127.   parse var box n x1 x2 y1 y2 z1 z2
  128.   cx=-(x2-x1)/2
  129.   cy=-(y2-y1)/2
  130.   call MOVE(cx 0 0)
  131.   return 2*cy
  132. Bevel_Flat:
  133.     return
  134.  
  135. Bevel_Block:
  136.     call bevel(0, deep / 2)
  137.     return
  138.  
  139. Bevel_Chisel:
  140.     call shapebevel(-wide wide (-wide) deep/2)
  141.     return
  142.  
  143. Bevel_Round:
  144.     n = 5
  145.     pat = ''
  146.     do i=1 to n
  147.         a = 3.14159/2 * i / n
  148.         pat = pat (-sin(a)*wide) (1-cos(a))*wide
  149.       end i
  150.     call shapebevel(pat (-wide) deep/2)
  151.     return
  152.  
  153. ShapeText: PROCEDURE expose wide styles deep
  154.   arg typ
  155.   sl1 = curlayer()
  156.   empty = emptylayers()
  157.   if (words(empty) < 1) then do
  158.     call notify 1,syscode,"!Need an empty layer","!for this operation."
  159.     exit
  160.     end
  161.   sl2 = word(empty, 1)
  162.   call copy
  163.   sbase=cursurface()
  164.   call setlayer sl2
  165.   call paste
  166.   call sel_mode('user')
  167.   call sel_polygon('set')
  168.   interpret 'call Bevel_' || word(styles, typ)
  169.   call cut
  170.   call changesurface(sbase || "_Side")
  171.   call setlayer sl1 /* Get the correct faces from sl1. */
  172.   call changesurface(sbase|| "_Face")
  173.   call flip
  174.   call cut
  175.   call setlayer sl2
  176.   call paste
  177.   call mirror(Z, -deep/2)
  178.   call mergepoints
  179.   call cut
  180.   call setlayer sl1
  181.   call paste
  182.   return
  183.